Project Part 2

---

This notebook contains the code samples found in Chapter 3, Section 5 of Deep Learning with R. Note that the original text features far more content, in particular further explanations and figures: in this notebook, you will only find source code and related comments.

---

Data Exploration & Preparation

• Our goal in the second part of the assignment is to predict how good a (new) customer will pay back their credit card depts. In the data set application data from current customers (the first 18 attributes) together with their status (last attribute; target) are given.
  
• The attributes from the applications are

Attribute Name	Explanation	Remarks
ID	Client	number
CODE_GENDER	Gender
FLAG_OWN_CAR	Is there a car
FLAG_OWN_REALTY	Is there a property
CNT_CHILDREN	Number of children
AMT_INCOME_TOTAL	Annual income
NAME_INCOME_TYPE	Income category
NAME_EDUCATION_TYPE	Education level
NAME_FAMILY_STATUS	Marital status
NAME_HOUSING_TYPE	Way of living
DAYS_BIRTH	Birthday	Count backwards from current day (0), -1 means yesterday
DAYS_EMPLOYED	Start date of employment	Count backwards from current day(0). If positive, it means the person unemployed.
FLAG_MOBIL	Is there a mobile phone
FLAG_WORK_PHONE	Is there a work phone
FLAG_PHONE	Is there a phone
FLAG_EMAIL	Is there an email
OCCUPATION_TYPE	Occupation
CNT_FAM_MEMBERS	Family size

• The last attribute status contains the “pay-back behavior”, i.e. when did that customer pay back their depts:
  • 0: 1-29 days past due
  • 1: 30-59 days past due
  • 2: 60-89 days overdue
  • 3: 90-119 days overdue
  • 4: 120-149 days overdue
  • 5: Overdue or bad debts, write-offs for more than 150 days
  • C: paid off that month
  • X: No loan for the month Please note: We are learning only the pay-back behavior. The decision, i.e. if we accept a customer or not, is done in another process step – not here!

---

Main task

• Design your network. Why did you use a feed-forward network, or a convolutional or recursive network – and why not?
  
• Use k-fold validation (with k = 10) to find the best hyperparameters for your network.
• Use the average of the accuracy to evaluate the performance of your trained network.
• Find a “reasonable” good model. Argue why that model is reasonable. If you are not able to find a reasonable good model, explain what you all did to find a good model and argue why you think that’s not a good model.
  
• Save your trained neural network with save_model_hdf5. Also save your data sets you used for training, testing and validation.

---

Some hints

• Data preprocessing is easier here; no feature engineering is needed.
• You may be able to reuse parts of the exercises we used in our examples during lectures.
• All in- and output values need to be floating numbers (or integers in exceptions) in the range of [0,1].
• Please note that a neural network expects a R matrix or vector, not data frames. Transform your data (e.g. a data frame) into a matrix with data.matrix if needed.
  
• There are some models which show an accuracy higher than 90% (!) for training (and test) data – after learning more than 1000 epochs.

---

Important notes

• Single-label, Multiclass classification problem on page 73 in Deep Learning with R
• Spaces must be removed in between ‘{r}' and '’, else an error with ‘’ will be produced
• K-Fold Validation on page 83ff and 94ff in Deep Learning with R
• Page 110, use Last-Layer activation softmax and loss function categorical_crossentropy
• Convolutional network ausgeschlossen, weil hauptsächlich Pattern recognition/image classification
• Recursive ausgeschlossen, weil hauptsächlich für TimeSeries-Vorhersagen verwendet, oder für Vorhersagen
• Feed-Forward, weil Classification-Task

---

Data import

#install.packages("tidymodels")
#install.packages("themis")
library(here)
library(tidyverse)
library(ggplot2)
library(dplyr)
library(tensorflow)
library(tfdatasets)
library(tidymodels)
library(keras)
library(caret)
library(themis)
#LOAD DATA
setwd(getwd())
dataIn = "../Data/Dataset-part-2.csv"
data_in <- read.csv(dataIn,header = TRUE, sep =',')
#View(data_in)
data <- data.frame(data_in)
summary(data)

       ID          CODE_GENDER        FLAG_OWN_CAR       FLAG_OWN_REALTY     CNT_CHILDREN     AMT_INCOME_TOTAL 
 Min.   :5008804   Length:67614       Length:67614       Length:67614       Min.   : 0.0000   Min.   :  26100  
 1st Qu.:5465941   Class :character   Class :character   Class :character   1st Qu.: 0.0000   1st Qu.: 112500  
 Median :5954270   Mode  :character   Mode  :character   Mode  :character   Median : 0.0000   Median : 157500  
 Mean   :5908133                                                            Mean   : 0.4206   Mean   : 178867  
 3rd Qu.:6289080                                                            3rd Qu.: 1.0000   3rd Qu.: 225000  
 Max.   :7965248                                                            Max.   :19.0000   Max.   :6750000  
 NAME_INCOME_TYPE   NAME_EDUCATION_TYPE NAME_FAMILY_STATUS NAME_HOUSING_TYPE    DAYS_BIRTH     DAYS_EMPLOYED   
 Length:67614       Length:67614        Length:67614       Length:67614       Min.   :-25201   Min.   :-17531  
 Class :character   Class :character    Class :character   Class :character   1st Qu.:-19438   1st Qu.: -2886  
 Mode  :character   Mode  :character    Mode  :character   Mode  :character   Median :-15592   Median : -1305  
                                                                              Mean   :-15914   Mean   : 62022  
                                                                              3rd Qu.:-12347   3rd Qu.:  -321  
                                                                              Max.   : -7489   Max.   :365243  
   FLAG_MOBIL FLAG_WORK_PHONE    FLAG_PHONE       FLAG_EMAIL     OCCUPATION_TYPE    CNT_FAM_MEMBERS 
 Min.   :1    Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Length:67614       Min.   : 1.000  
 1st Qu.:1    1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   Class :character   1st Qu.: 2.000  
 Median :1    Median :0.0000   Median :0.0000   Median :0.0000   Mode  :character   Median : 2.000  
 Mean   :1    Mean   :0.2028   Mean   :0.2742   Mean   :0.1005                      Mean   : 2.174  
 3rd Qu.:1    3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:0.0000                      3rd Qu.: 3.000  
 Max.   :1    Max.   :1.0000   Max.   :1.0000   Max.   :1.0000                      Max.   :20.000  
    status         
 Length:67614      
 Class :character  
 Mode  :character  
                   
                   
                   

plot(data$status)

##Cleanup

# Check for duplicates 
sum(duplicated(data))

[1] 0

# No duplicates

#Remove ID (irrelevant) and FLAG_MOBIL (always 1)
data <- data %>% select(-ID, -FLAG_MOBIL)
cols <- c("CODE_GENDER","FLAG_OWN_CAR","FLAG_OWN_REALTY","NAME_INCOME_TYPE","NAME_EDUCATION_TYPE", "NAME_FAMILY_STATUS", "NAME_HOUSING_TYPE","FLAG_WORK_PHONE","FLAG_PHONE","FLAG_EMAIL", "OCCUPATION_TYPE","status")
cols

 [1] "CODE_GENDER"         "FLAG_OWN_CAR"        "FLAG_OWN_REALTY"     "NAME_INCOME_TYPE"   
 [5] "NAME_EDUCATION_TYPE" "NAME_FAMILY_STATUS"  "NAME_HOUSING_TYPE"   "FLAG_WORK_PHONE"    
 [9] "FLAG_PHONE"          "FLAG_EMAIL"          "OCCUPATION_TYPE"     "status"             

data[cols] <- lapply(data[cols],factor)

# Replacing empty values with "Unknown"
levels(data$OCCUPATION_TYPE) <- c(levels(data$OCCUPATION_TYPE), "Unknown")
data$OCCUPATION_TYPE[is.na(data$OCCUPATION_TYPE)] <- "Unknown"

# Replacing C and X in Status
levels(data$status)[levels(data$status)=="C"] <- "6"
#data$status[data$status == "X"] <- 7
levels(data$status)[levels(data$status)=="X"] <- "7"
# #Convert factors into numericals
# data %<>% mutate_if(is.factor, as.numeric)

summary(data)

 CODE_GENDER FLAG_OWN_CAR FLAG_OWN_REALTY  CNT_CHILDREN     AMT_INCOME_TOTAL              NAME_INCOME_TYPE
 F:43924     N:43107      N:21090         Min.   : 0.0000   Min.   :  26100   Commercial associate:15640  
 M:23690     Y:24507      Y:46524         1st Qu.: 0.0000   1st Qu.: 112500   Pensioner           :11982  
                                          Median : 0.0000   Median : 157500   State servant       : 5044  
                                          Mean   : 0.4206   Mean   : 178867   Student             :    4  
                                          3rd Qu.: 1.0000   3rd Qu.: 225000   Working             :34944  
                                          Max.   :19.0000   Max.   :6750000                               
                                                                                                          
                    NAME_EDUCATION_TYPE            NAME_FAMILY_STATUS           NAME_HOUSING_TYPE
 Academic degree              :   38    Civil marriage      : 6016    Co-op apartment    :  227  
 Higher education             :16890    Married             :44906    House / apartment  :60307  
 Incomplete higher            : 2306    Separated           : 4125    Municipal apartment: 2303  
 Lower secondary              :  716    Single / not married: 9528    Office apartment   :  587  
 Secondary / secondary special:47664    Widow               : 3039    Rented apartment   : 1020  
                                                                      With parents       : 3170  
                                                                                                 
   DAYS_BIRTH     DAYS_EMPLOYED    FLAG_WORK_PHONE FLAG_PHONE FLAG_EMAIL    OCCUPATION_TYPE  CNT_FAM_MEMBERS 
 Min.   :-25201   Min.   :-17531   0:53904         0:49071    0:60819    Unknown    :20699   Min.   : 1.000  
 1st Qu.:-19438   1st Qu.: -2886   1:13710         1:18543    1: 6795    Laborers   :12425   1st Qu.: 2.000  
 Median :-15592   Median : -1305                                         Sales staff: 6899   Median : 2.000  
 Mean   :-15914   Mean   : 62022                                         Core staff : 6059   Mean   : 2.174  
 3rd Qu.:-12347   3rd Qu.:  -321                                         Managers   : 4950   3rd Qu.: 3.000  
 Max.   : -7489   Max.   :365243                                         Drivers    : 4427   Max.   :20.000  
                                                                         (Other)    :12155                   
     status     
 0      :52133  
 1      : 6491  
 7      : 5790  
 6      : 1805  
 2      :  712  
 5      :  374  
 (Other):  309  

Preprocessing

set.seed(1)
trainIndex <- initial_split(data, prop = 0.8, strata = status) 
trainingSet <- training(trainIndex)
testSet <- testing(trainIndex)
status_folds <- vfold_cv(trainingSet, v = 10, strata = status)
status_folds

#  10-fold cross-validation using stratification 

# Remove outliers (Out of 1.5x Interquartile Range)
# CNT_CHILDREN
boxplot(trainingSet$CNT_CHILDREN, horizontal=TRUE, main="CNT_CHILDREN")

Q1_Child <- quantile(trainingSet$CNT_CHILDREN, .25)
Q3_Child <- quantile(trainingSet$CNT_CHILDREN, .75)
IQR_Child <- IQR(trainingSet$CNT_CHILDREN)
# Now we keep the values within 1.5*IQR of Q1 and Q3
trainingSet <- subset(trainingSet, trainingSet$CNT_CHILDREN > (Q1_Child - 1.5*IQR_Child) & trainingSet$CNT_CHILDREN < (Q3_Child + 1.5*IQR_Child))
dim(trainingSet)

[1] 53330    17

# AMT_INCOME_TOTAL
boxplot(trainingSet$AMT_INCOME_TOTAL, horizontal=TRUE, main="AMT_INCOME_TOTAL")

Q1_AIT <- quantile(trainingSet$AMT_INCOME_TOTAL, .25)
Q3_AIT <- quantile(trainingSet$AMT_INCOME_TOTAL, .75)
IQR_AIT <- IQR(trainingSet$AMT_INCOME_TOTAL)
# Now we keep the values within 1.5*IQR of Q1 and Q3
trainingSet <- subset(trainingSet, trainingSet$AMT_INCOME_TOTAL > (Q1_AIT - 1.5*IQR_AIT) & trainingSet$AMT_INCOME_TOTAL < (Q3_AIT + 1.5*IQR_AIT))
dim(trainingSet)

[1] 51748    17

set.seed(5)
preprocRecipe <-
  recipe(status ~., data = data) %>%
  step_dummy(all_nominal(), -status,  one_hot = TRUE) %>%
  step_range(all_predictors(), -all_nominal(), min = 0, max = 1)%>%
 # step_downsample(status, over_ratio = 1) %>%
  step_smote(status, over_ratio = 1, skip=TRUE) %>%
 # step_smotenc(status, over_ratio = 1) %>%
 #step_adasyn(status, over_ratio = 1) %>%
 #step_nearmiss(status, over_ratio = 1) %>%
   
  step_dummy(status,  one_hot = TRUE)# %>%

In this step the above defined receipt is extracted using the prep() function, and then use the bake() function to transform a set of data based on that recipe.

# retain = TRUE and new_data = NULL ensures that pre-processed trainingSet is returned 
trainingSet_processed <- preprocRecipe %>%
  prep(trainingSet, retain = TRUE) %>%
  bake(new_data = NULL)
testSet_processed <- preprocRecipe %>%
  prep(testSet) %>%
  bake(new_data =testSet)

#summary(trainingSet_processed)

Check data

# summarize the class distribution
percentage <- 100-prop.table(table(data$status)) * 100
cbind(freq=table(data$status), percentage=percentage)
class_weights <- list("0"=1,"1"=100)

# Turn data frame into data matrix
matrix_data <- trainingSet_processed %>% select(-tail(names(trainingSet_processed), 8))
matrix_targets <- trainingSet_processed %>% select(tail(names(trainingSet_processed), 8))

matrix_data_test  <- testSet_processed %>% select(-tail(names(testSet_processed), 8))
matrix_targets_test  <- testSet_processed %>% select(tail(names(testSet_processed), 8))

#Subset only 100 entries for testing
#matrix_data <- matrix_data[1:100, ]
#matrix_targets <- matrix_targets[1:100, ]

Build Model

#train_data <- matrix_data
train_data <- data.matrix(matrix_data)
test_data <- data.matrix(matrix_data_test)
train_targets <- data.matrix(matrix_targets)
test_targets <- data.matrix(matrix_targets_test)

# Function to build the model
build_model <- function() {
  model <- keras_model_sequential() %>%
    #layer_batch_normalization(axis = -1L, input_shape = dim(train_data)[[2]]) %>%
    layer_dense(units = 64, activation = "relu", input_shape = dim(train_data)[[2]]) %>%
    layer_dropout(0.3) %>%
    layer_dense(units = 64, activation = "relu") %>%
    layer_dropout(0.3) %>%
    layer_dense(units = 8, activation = "softmax") 

  model %>% compile(
    optimizer = optimizer_sgd(learning_rate = 0.2),
    loss = "categorical_crossentropy",
    metrics = "categorical_accuracy"
  )

}

K-Fold-Validation

# mean <- apply(matrix_data, 2, mean)
# std <- apply(matrix_data, 2, sd)
# train_data <- scale(matrix_data, center = mean, scale = std)
# test_data <- scale(matrix_data, center = mean, scale = std)
# train_targets <- matrix_targets


k <- 10
indices <- sample(1:nrow(train_data))
folds <- cut(indices, breaks = k, labels = FALSE)

num_epochs <- 1500
all_acc_histories <- NULL
for (i in 1:k) {
  cat("processing fold #", i, "\n")

  val_indices <- which(folds == i, arr.ind = TRUE)
  val_data <- train_data[val_indices,] #test_data#
  val_targets <- train_targets[val_indices,] #test_targets#
  
  partial_train_data <- train_data[-val_indices,]
  partial_train_targets <- train_targets[-val_indices,]
  model <- build_model()

  # Train the model (in silent mode, verbose=0)
  # Batch size https://stats.stackexchange.com/questions/153531/what-is-batch-size-in-neural-network
  # One epoch = one forward pass and one backward pass of all the training examples
  # Batch size = the number of training examples in one forward/backward pass. The higher the batch size, the more memory space you'll need.
  # Number of iterations = number of passes, each pass using [batch size] number of examples. To be clear, one pass = one forward pass + one backward pass (we do not count the forward pass and backward pass as two different passes).
  # Batch size 32 much faster than 1, also the smaller the batch the less accurate the estimate of the gradient will be.
  history <- model %>% fit(
    partial_train_data, partial_train_targets,
    validation_data = list(val_data, val_targets),
    epochs = num_epochs, batch_size = 128, verbose = 2, class_weights = percentage
  )
  acc_history <- history$metrics$val_categorical_accuracy
  all_acc_histories <- rbind(all_acc_histories, acc_history)
}


#reticulate::py_last_error()

#We can then compute the average of the per-epoch ACC scores for all folds:

average_acc_history <- data.frame(
  epoch = seq(1:ncol(all_acc_histories)),
  validation_acc = apply(all_acc_histories, 2, mean)
)


max(average_acc_history$validation_acc)

library(ggplot2)
ggplot(average_acc_history, aes(x = epoch, y = validation_acc)) + geom_line()

#It may be a bit hard to see the plot due to scaling issues and relatively high variance. Let's use `geom_smooth()` to try to get a clearer picture:
ggplot(average_acc_history, aes(x = epoch, y = validation_acc)) + geom_smooth()

# Evaluate on Testset
eval <- evaluate(model, test_data, test_targets, verbose = 1)
eval

# Save model and history, please change the name
# write.csv(average_acc_history, "../Doc/Versuch 3/Try 3.csv", row.names=FALSE)
# save_model_hdf5(model, "../Doc/Versuch 3/model 3.hfd5", overwrite = TRUE, include_optimizer = TRUE)

# Load model
# Use model_history as precaution
# model_history <- load_model_hdf5("../Doc/Versuch 3/model 3.hfd5", custom_objects = NULL, compile = TRUE)